library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggthemes)
library(here)
## here() starts at /Users/golemxiv/Documents/dydaktyka/wizualizacjaR
Z użyciem here::here by uniknąć problemów z relatywnymi i absolutnymi ścieżkami
panteon <- read_csv(here("podstawy", "panteon_s.csv"))
## Rows: 11341 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): name, countryName, countryCode3, continentName, gender, industry, d...
## dbl (6): LAT, LON, birthyear, L_star, HPI, AverageViews
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Na wszelki wypadek, gdybyśmy mieli poblemy z here dane z internetu:
panteon <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/main/podstawy/panteon_s.csv")
## Rows: 11341 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): name, countryName, countryCode3, continentName, gender, industry, d...
## dbl (6): LAT, LON, birthyear, L_star, HPI, AverageViews
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
gdp <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/refs/heads/main/komunikowanie%20danych/gdp_percap.csv")
## Rows: 255 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): country_name, country_code
## dbl (1): gdp_percap
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
pop <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/refs/heads/main/komunikowanie%20danych/pop_total.csv")
## Rows: 265 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): country_name, country_code
## dbl (1): pop_total
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Stworzymy wykres na podstawie połączenia danych panteon i danych banku świadowego o gdp.percap
panteon_c <- panteon %>%
filter(!is.na(continentName), continentName != "Unknown")
panteon_c <- panteon %>%
filter(!is.na(continentName), continentName != "Unknown") %>%
group_by(countryCode3, continentName) %>%
summarise(sławni = n()) %>%
ungroup()
## `summarise()` has grouped output by 'countryCode3'. You can override using the
## `.groups` argument.
panteon_d <- panteon_c %>%
left_join(gdp)
panteon_d <- panteon_c %>%
left_join(gdp, by = c("countryCode3" = "country_code"))
panteon_d %>%
ggplot(aes(x = gdp_percap, y = sławni)) +
geom_jitter() +
geom_smooth() +
facet_wrap(~continentName)
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning: Removed 13 rows containing non-finite outside the scale range
## (`stat_smooth()`).
## Warning: Removed 13 rows containing missing values or values outside the scale range
## (`geom_point()`).
panteon_d %>%
ggplot(aes(x = gdp_percap, y = sławni)) +
scale_x_log10() +
scale_y_log10() +
geom_jitter() +
geom_smooth() +
facet_wrap(~continentName)
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning: Removed 13 rows containing non-finite outside the scale range
## (`stat_smooth()`).
## Warning: Removed 13 rows containing missing values or values outside the scale range
## (`geom_point()`).
Stwórzmy wykres porównujący liczbę celebrytów per capita w danym kraju z pkb per capita w danym kraju na podstawie danych panteon, gdp i pop,
podpowiedź: użyjmy left_join i mutate
panteon_e <- panteon_c %>%
left_join(pop, by = c("countryCode3" = "country_code")) %>%
mutate(sławni_percap = sławni/pop_total*10000)
panteon_e %>%
ggplot(aes(x = sławni, y = pop_total)) +
scale_x_log10() +
scale_y_log10() +
geom_jitter() +
geom_smooth() +
facet_wrap(~continentName)
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning: Removed 4 rows containing non-finite outside the scale range
## (`stat_smooth()`).
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at -0.0099782
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 0.4871
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 0
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 0.22764
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## -0.0099782
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 0.4871
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 0
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 0.22764
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
str(pop)
## spc_tbl_ [265 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ country_name: chr [1:265] "Aruba" "Africa Eastern and Southern" "Afghanistan" "Africa Western and Central" ...
## $ country_code: chr [1:265] "ABW" "AFE" "AFG" "AFW" ...
## $ pop_total : num [1:265] 1.07e+05 7.51e+08 4.15e+07 5.09e+08 3.67e+07 ...
## - attr(*, "spec")=
## .. cols(
## .. country_name = col_character(),
## .. country_code = col_character(),
## .. pop_total = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
p <- ggplot(panteon_c, aes(x = reorder(continentName, sławni),
y = sławni,
color = continentName)) +
scale_y_log10() +
geom_boxplot() +
geom_jitter()
p
p <- ggplot(panteon_c, aes(x = reorder(continentName, sławni, FUN = median),
y = sławni,
color = continentName,
fill = continentName)) +
scale_y_log10() +
geom_boxplot()
p
p + theme(legend.position="left", legend.title.position = "bottom")
Usuwanie legendy
p + theme(legend.position="none",
)
Zmiana poprzez zmianę kolejności faktorów
Żeby zmienić kolejność w legendzie trzeba dodać guides() i guide_legend() do geom_point(). W
p +
guides(color = guide_legend(reverse = TRUE),
fill = guide_legend(reverse = TRUE)) #
narysujemy wykres według płci,AverageViews
panteon %>%
ggplot() +
geom_boxplot(aes(x = reorder(gender,AverageViews),
y = AverageViews)) +
scale_y_log10(breaks = c(100, 10000, 1000000),
labels = c("", "10 tys.", "1 mln.")) +
scale_x_discrete(labels = c("mężczyzna", "kobieta")) +
labs(x = "płeć",
title = "boxplot") +
theme(plot.title = element_text(hjust = 0)) +
theme_wsj()
# usuwa legendę koloru wypełnienia
p + scale_color_manual(values=c('pink','steelblue','#56B4E9', "red", "135", "gray56"),
guide = "none") #
p + guides(
color = guide_legend(
reverse = TRUE,
title.position = "bottom",
label.position = "bottom",
keywidth = 6,
nrow = 3
)
)
etykiety <- c("Afryka", "Azja", "Europa", "Ameryka Północna", "Oceania", "Ameryka Południowa")
t <- ggplot(panteon_c, aes(x = continentName,
y = sławni,
color = continentName)) +
#scale_color_manual(values=c('pink','steelblue','#56B4E9', "red", "135", "gray56"))+
scale_y_log10() +
scale_x_discrete(labels = etykiety) +
geom_boxplot()
t +
scale_color_manual(
name = "Nowy tytuł legendy", # Zmiana tytułu legendy
values = c('pink','steelblue','#56B4E9', "red", "135", "gray56"), # Ręczne ustawienie kolorów
labels = etykiety) +
guides(
color = guide_legend(
reverse = TRUE,
title.position = "bottom",
label.position = "bottom",
keywidth = 6,
nrow = 3
)
)
panteon %>%
ggplot() +
geom_boxplot(aes(x = gender,
y = AverageViews)) +
scale_y_log10()
panteon %>%
ggplot() +
geom_histogram(aes(AverageViews))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Można doknowywać przekształceeń za pomocą skali
p1 <- panteon %>%
ggplot() +
geom_boxplot(aes(x = reorder(gender, AverageViews), y = AverageViews)) +
scale_y_log10()
p1
Można ręcznie ustalać liczbę znaczników na skali
p1 +
labs(x = "płeć",
y = "wyświetlenia",
title = "Rozkład wyświetleń\nwedług płci") +
scale_x_discrete(labels = c("kobieta", "mężczyzna")) +
scale_y_log10(breaks = c(0, 100000, 1000000),
labels = c("0", "100 tys.", "1 mln.")) +
theme_bw()
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
#install.packages("ggthemes")
library(ggthemes)
panteon %>%
ggplot() +
geom_boxplot(aes(x = gender, y = AverageViews)) +
scale_y_log10(breaks = c(0, 100000, 1000000), labels = c("", "100 tys.", "1 mln")) +
scale_x_discrete(labels = c("kobiety", "mężczyźni")) +
labs(y = "średnia wyświetleń",
x = "",
title = "Biografie kobiet są średnio częściej wyświetlane niż biografie mężczyzn",
subtitle = "Rozkład średniej wyświetleń biografii postaci z Panteon 1.0",
caption = "Źródło: Panteon 1.0")
w1 <- panteon %>%
ggplot() +
geom_boxplot(aes(x = gender, y = AverageViews)) +
scale_y_log10(breaks = c(0, 100000, 1000000), labels = c("", "100 tys.", "1 mln")) +
scale_x_discrete(labels = c("kobiety", "mężczyźni")) +
labs(y = "średnia wyświetleń",
x = "",
title = "Biografie kobiet są średnio częściej wyświetlane niż biografie mężczyzn",
subtitle = "Rozkład średniej wyświetleń biografii postaci z Panteon 1.0")
w1
ggplot(mpg, aes(x = hwy, y = cty)) +
geom_point() +
geom_text(aes(label = manufacturer))
ggplot(panteon, aes(x = HPI, y = L_star)) +
geom_point() +
geom_text(aes(label = name))
polki <- panteon %>%
filter(countryCode3 == "POL" & gender == "Female")
panteon %>%
filter(countryCode3 == "POL" & gender == "Female") %>%
ggplot(aes(x = L_star, y = HPI, size = AverageViews)) +
geom_point(aes(size = AverageViews)) +
geom_point(data = polki %>% filter(name == "Doda"), color= "red") +
geom_label(aes(label = name), nudge_y = 5, hjust = 1.5, vjust = 1.5)
Zastosowanie funkcji z biblioteki ggrepel
#install.packages("ggrepel")
library(ggrepel)
panteon %>%
filter(countryCode3 == "POL" & gender == "Female") %>%
ggplot(aes(x = L_star, y = HPI)) +
geom_point(aes(size = AverageViews)) +
geom_text_repel(aes(label = name))
panteon %>%
filter(countryCode3 == "POL" & gender == "Female") %>%
ggplot(aes(x = L_star, y = HPI)) +
geom_point(aes(size = AverageViews)) +
geom_text_repel(aes(label = name)) +
annotate(geom = "text",
x=8,
y=30,
label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II") #cudzysłów wewnętrz cudzysłowu musi się różnić od zewnętrznego
panteon %>%
filter(countryCode3 == "POL" & gender == "Female") %>%
ggplot(aes(x = L_star, y = HPI)) +
geom_point(aes(size = AverageViews)) +
geom_text_repel(aes(label = name)) +
annotate(geom = "text", x=8, y=30, label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II",) +
annotate(geom = "rect", xmin = 7.5, xmax = 11, ymin = 27, ymax = 29, fill = "red", alpha = 0.2) #adnotacja w postaci prostokąta
panteon %>%
filter(countryCode3 == "POL" & gender == "Female") %>%
ggplot(aes(x = L_star, y = HPI)) +
geom_point(aes(size = AverageViews)) +
geom_text_repel(aes(label = name)) +
annotate(geom = "text", x = 5, y = 30, label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II") +
geom_segment(aes(x = 6, xend = 9, y = 30, yend = 28),
arrow = arrow(type = "closed", length = unit(0.2, "inches"))) # Dodanie strzałki
## Warning in geom_segment(aes(x = 6, xend = 9, y = 30, yend = 28), arrow = arrow(type = "closed", : All aesthetics have length 1, but the data has 17 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
Filtrowanie danych wewnątrz geometrii
polki <- panteon %>%
filter(countryCode3 == "POL" & gender == "Female")
ggplot(polki, aes(x = L_star, y = HPI)) +
geom_point(aes(size = AverageViews)) +
geom_text_repel(data = polki %>% filter(AverageViews > mean(polki$AverageViews)), aes(label = name), nudge_y = 1.5) +
annotate(geom = "text", x=8, y=30, label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II",) +
annotate(geom = "rect", xmin = 7.5, xmax = 11, ymin = 27, ymax = 29, fill = "red", alpha = 0.2) +
guides(size = "none")
panteon %>%
filter(countryCode3 == "POL" & gender == "Female") %>%
ggplot(aes(x = L_star, y = HPI)) +
geom_point(aes(size = AverageViews)) +
geom_text_repel(aes(label = name)) +
geom_vline(xintercept = mean(panteon$L_star)) +
geom_hline(yintercept = mean(panteon$HPI))
Linia ze strzałką
panteon %>%
filter(countryCode3 == "POL" & gender == "Female") %>%
ggplot(aes(x = L_star, y = HPI)) +
geom_point(aes(size = AverageViews)) +
geom_text_repel(aes(label = name)) +
annotate(geom = "text",
x=8,
y=30,
label = "Jedną z bardziej znanych 'Polek' \n okazuje się Katarzyna II") +
geom_segment(aes(x = 8, xend = 9.4 ,
y= 29,
yend = 27.9),
arrow = arrow(length = unit(0.1,"cm"))) +
geom_curve(aes(x = 8, xend = 9.4 ,
y= 29,
yend = 27.9),
arrow = arrow(length = unit(0.1,"cm")))
## Warning in geom_segment(aes(x = 8, xend = 9.4, y = 29, yend = 27.9), arrow = arrow(length = unit(0.1, : All aesthetics have length 1, but the data has 17 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
## Warning in geom_curve(aes(x = 8, xend = 9.4, y = 29, yend = 27.9), arrow = arrow(length = unit(0.1, : All aesthetics have length 1, but the data has 17 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
## a single row.
więcej na ten temat na ciekawej stronie R Graph Gallery
?rgb()
kolor1 <- rgb(144, 26, 40, maxColorValue = 255) # domyślnie jest na skali intensywności 0-1 dlatego przy skali 0-255 trzeba ustalić argument maxColorValue na 255
kolor2 <- rgb(200, 131, 84, maxColorValue = 255)
print(kolor1)
## [1] "#901A28"
print(kolor2)
## [1] "#C88354"
ggplot(mtcars, aes(x=drat)) +
geom_density(color= kolor2,
fill=kolor1,
linewidth=2 )
ggplot(mtcars, aes(x=drat)) +
geom_density( color = "#C88354",
fill="#901A28",
linewidth=2 )
Powyższy przykłąd to zapis zapis heksadecymalny, który jest często używany w grafice komputerowej i web designie. Składa się on z sześciu znaków, przy czym każdy parzysty zestaw dwóch znaków reprezentuje jedną z trzech podstawowych składowych koloru: czerwony (R), zielony (G) i niebieski (B). Każdy zestaw może przyjmować wartość od 00 do FF w systemie szesnastkowym, co odpowiada wartościom od 0 do 255 w systemie dziesiętnym.
ggplot(mtcars, aes(x=drat)) +
geom_density(color=(rgb(200, 131, 84,
maxColorValue = 255)),
fill= (rgb(63, 74, 84,
maxColorValue = 255)), linewidth=2)
#20 pierwszych nazw kolrów
r_color <- colors()
head(r_color, 20)
## [1] "white" "aliceblue" "antiquewhite" "antiquewhite1"
## [5] "antiquewhite2" "antiquewhite3" "antiquewhite4" "aquamarine"
## [9] "aquamarine1" "aquamarine2" "aquamarine3" "aquamarine4"
## [13] "azure" "azure1" "azure2" "azure3"
## [17] "azure4" "beige" "bisque" "bisque1"
## przykłdowa lista nazw kolorów:
plot(0, 0, type = "n", xlim = c(0, 1), ylim = c(0, 1), axes = FALSE, xlab = "", ylab = "")
# Settings
line <- 25
col <- 5
# Add color background
rect(
rep((0:(col - 1)/col),line) ,
sort(rep((0:(line - 1)/line),col),decreasing=T),
rep((1:col/col),line) ,
sort(rep((1:line/line),col),decreasing=T),
border = "white" ,
col=colors()[seq(1,line*col)])
# Color names
text(
rep((0:(col - 1)/col),line)+0.1 ,
sort(rep((0:(line - 1)/line),col),decreasing=T)+0.015 ,
colors()[seq(1,line*col)] ,
cex=0.6)
ggplot(mtcars, aes(x=drat)) +
geom_density(color= "darkorange1",
fill= "darkslategray",
linewidth=2 )
ggplot(mtcars, aes(x=drat)) +
geom_density(color= "darkorange1",
fill= "darkslategray",
linewidth=2 ) +
theme(axis.text.y = element_text(angle = 45))
kolor3 = colors()[143]
#numery kolorów
par(mar=c(0,0,0,0))
plot(0, 0, type = "n", xlim = c(0, 1), ylim = c(0, 1), axes = FALSE, xlab = "", ylab = "")
# parametry
line <- 31
col <- 21
# Rectangles
rect( rep((0:(col - 1)/col),line) , sort(rep((0:(line - 1)/line),col),decreasing=T) , rep((1:col/col),line) , sort(rep((1:line/line),col),decreasing=T),
border = "light gray" , col=colors()[seq(1,651)])
# Text
text( rep((0:(col - 1)/col),line)+0.02 , sort(rep((0:(line - 1)/line),col),decreasing=T)+0.01 , seq(1,651) , cex=0.5)
ggplot(mtcars, aes(x=drat)) +
geom_density(color= colors()[53],
fill= colors()[593],
linewidth=2 )
#install.packages("RColorBrewer")
library(RColorBrewer)
dev.off()
## null device
## 1
par(mfrow=c(1,1))
display.brewer.all()
display.brewer.all(colorblindFriendly = TRUE)
#install.packages("viridis")
library(viridis)
## Loading required package: viridisLite
scale_fill_viridis(discrete = TRUE)
Użyjemy danych ze zbioru ToothGrowth
glimpse(ToothGrowth)
## Rows: 60
## Columns: 3
## $ len <dbl> 4.2, 11.5, 7.3, 5.8, 6.4, 10.0, 11.2, 11.2, 5.2, 7.0, 16.5, 16.5,…
## $ supp <fct> VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, VC, V…
## $ dose <dbl> 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 1.0, 1.0, 1.0, …
ToothGrowth$dose <- as.factor(ToothGrowth$dose)
mtcars$cyl <- as.factor(mtcars$cyl)
#boxplot
bp <- ggplot(ToothGrowth, aes(x=dose, y=len))
# scatter plot
sp <- ggplot(mtcars, aes(x=wt, y=mpg))
bp + geom_boxplot(fill = "steelblue", color = "red")
sp + geom_point(color = 'darkblue')
bp <- bp + geom_boxplot(aes(fill = dose))
sp <- sp + geom_point(aes(color = cyl))
Jasność (lighteness) (l) i chroma (c, intensity of color) domyślnych kolorów (hue) kolory można modyfikować scale_hue
bp + scale_fill_hue(l=40, c=35)
# Scatter plot
sp + scale_color_hue(l=40, c=35)
bp + scale_fill_manual(values=c("#999999", "#E69F00", "#56B4E9"))
sp + scale_color_manual(values=c("#999999", "#E69F00", "#56B4E9"))
sp + scale_color_brewer(palette="Dark2")
Wymaa instalacji pakietu wesanderson
#install.packages("wesanderson")
library(wesanderson)
bp + scale_fill_manual(values=wes_palette(n=3, name="GrandBudapest1"))
sp+scale_color_manual(values=wes_palette(n=3, name="GrandBudapest1"))
ciągłe skale kolorów
scale_color_gradient(), scale_fill_gradient() sekwencyjne gradienty między dwoma kolorami
scale_color_gradient2(), scale_fill_gradient2() dywergentne gradienty
scale_color_gradientn(), scale_fill_gradientn() gradienty między n kolorami
sp2 <- ggplot(mtcars, aes(x = wt, y = mpg)) +
geom_point(aes(color = qsec))
sp2
# Change the low and high colors
# sekwencyjna
sp2+scale_color_gradient(low="blue", high="red")
# Ddywergentna
mid <- mean(mtcars$qsec)
sp2 + scale_color_gradient2(midpoint = mid, low = "blue",
mid = "white",
high = "red",
space = "Lab" )
## gradeinty n-kolorów
sp3 <- ggplot(mtcars, aes(x = wt, y = mpg)) +
geom_point(aes(color = mpg))
sp3
Za pmoocą funkcji theme_set możemy ustalić parametry wyglądu motywu dla wszystkich kolejnych wykresów
theme_set(theme_bw())
sp3 + theme(legend.position = "bottom")
sp3 +
theme(plot.title = element_text(size = rel(0.9)),
plot.subtitle = element_text(size = rel(0.4)))
sp3 +
theme(plot.title = element_text(size = rel(0.9),
family = "Times",
face = "bold.italic",
colour = "salmon"),
plot.subtitle = element_text(size = rel(0.4)))
Dodatkowe biblioteki, doinstalujmy jeśli nie mamy i wczytajmy
library(scales)
##
## Attaching package: 'scales'
## The following object is masked from 'package:viridis':
##
## viridis_pal
## The following object is masked from 'package:purrr':
##
## discard
## The following object is masked from 'package:readr':
##
## col_factor
library(RColorBrewer)
Dane:
# dane dla stacji Okęcie od 1880 roku
temp_okęcie <- read_csv(here("komunikowanie danych", "okecie_temp.csv"))
## Rows: 145 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (3): YEAR, ta, td
## date (1): date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
ustawianie skali z wykorzystaniem RColorBrewer
col_strip <- brewer.pal(11, "RdBu")
ggplot(temp_okęcie,
aes(x = date, y = 1, fill = ta))+
geom_tile() +
scale_x_date(date_breaks = "10 years",
date_labels = "%Y",
expand = c(0, 0))+
scale_y_continuous(expand = c(0, 0)) +
scale_fill_gradientn(colors = rev(col_strip)) +
guides(fill = guide_colorbar(barwidth = 1)) +
labs(title = "Okęcie 1880-2024",
caption = "Dane: GISS Surface Temperature Analysis") +
theme_minimal()
ggsave("ocieplenie_okęcie.png", width=8, height=4.5)
Ustawimy motyw
theme_strip <- theme_minimal()+
theme(axis.text.y = element_blank(),
axis.line.y = element_blank(),
axis.title = element_blank(),
panel.grid.major = element_blank(),
legend.title = element_blank(),
axis.text.x = element_text(vjust = 3),
panel.grid.minor = element_blank(),
plot.title = element_text(size = 14, face = "bold")
)
o <- ggplot(temp_okęcie,
aes(x = YEAR, y = 1, fill = ta)) +
geom_tile() +
scale_x_continuous(breaks=seq(1890, 2020, 30))+
scale_y_continuous(expand = c(0, 0)) +
scale_fill_gradientn(colors = rev(col_strip)) +
guides(fill = "none") +
labs(title = "Okęcie 1880-2024",
caption = "Dane: GISS Surface Temperature Analysis") +
theme_strip
ggplot(temp_okęcie,
aes(x = date, y = 1, fill = ta)) +
geom_tile() +
scale_x_date(date_breaks = "20 years",
date_labels = "%Y",
expand = c(0, 0))+
scale_y_continuous(expand = c(0, 0)) +
scale_fill_gradientn(colors = rev(col_strip)) +
guides(fill = "none") +
labs(title = "Okęcie 1880-2024",
caption = "Dane: GISS Surface Temperature Analysis") +
theme_strip
(o <- temp_okęcie %>%
ggplot(aes(x = YEAR, y = 1, fill = td)) +
geom_tile(show.legend = FALSE) +
scale_fill_stepsn(colors=c("#08306B", "white", "#67000D"),
values = rescale(c(min(temp_okęcie$td, na.rm = TRUE), 0, max(temp_okęcie$td, na.rm = TRUE))),
n.breaks = 12) +
coord_cartesian(expand=FALSE) +
scale_x_continuous(breaks=seq(1890, 2020, 30)) +
#labs(title= glue("Global temperature change ({min(t_data$year)}-{max(t_data$year)})")) +
theme_void() +
theme(
axis.text.x = element_text(color="white",
margin =margin(t=5, b=10, unit="pt")),
plot.title = element_text(color="white",
margin =margin(b=5, t=10, unit="pt"),
hjust= 0.05),
plot.background = element_rect(fill="black")
))
#install.packages("plotly")
plotly::ggplotly(o)
Stwórzmy wykres podobny do tego:
na podstawie danych:
pay_gap <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/main/case%20studies%20/pay_gap_uk.csv")
## Rows: 81 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): occupation, category, pay_gap_as_a_percentage
## dbl (3): women_average_annual_salary, men_average_annual_salary, pay_gap
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Powyższy wykres jest interaktywny. W odpowiedzi na zadanie wystarczy wykres statyczny. Uporządkujmy zawody według różnicy pensji. Możemy pominąć główne kategorie a zostać przy konkretnych zawodach. Postarajmy sięzachować kolory. Wskazówki: - użyjmy geom_segment i geom_point, - można zwiększyć interaktywność wykresu, używając plotly::ggplotly i estetyki text by móc pokazywać wysokość średniej pensji w chmurce, tak jak w wykresie z linku - używając różnych ustawień i funkcji wewnątrz theme_ możemy zredukować liczbę linii siatki i modyfikować inne elementy, możliwie upodobniając nasz wykres do wzoru
P.S.
#### Poniższy kod wyłącza notację naukową
options(scipen =999)